home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / ASM / OBJHASH.ASM < prev    next >
Encoding:
Assembly Source File  |  1993-06-13  |  6.3 KB  |  227 lines
  1. ;* OBJHASH.ASM
  2. ;************************************************************************
  3. ;*                                    *
  4. ;*        PC Scheme/Geneva 4.00 Borland TASM code            *
  5. ;*                                    *
  6. ;* (c) 1985-1988 by Texas Instruments, Inc. See COPYRIGHT.TXT        *
  7. ;* (c) 1992 by L. Bartholdi & M. Vuilleumier, University of Geneva    *
  8. ;*                                    *
  9. ;*----------------------------------------------------------------------*
  10. ;*                                    *
  11. ;*        Support for Obj-hash & unhash                *
  12. ;*                                    *
  13. ;*----------------------------------------------------------------------*
  14. ;*                                    *
  15. ;* Created by: John Jensen        Date: 1985            *
  16. ;* Revision history:                            *
  17. ;* - 18 Jun 92:    Renaissance (Borland Compilers, ...)            *
  18. ;*                                    *
  19. ;*                    ``In nomine omnipotentii dei''    *
  20. ;************************************************************************
  21. IDEAL
  22. %PAGESIZE    60, 132
  23. MODEL    medium
  24. LOCALS    @@
  25.  
  26.     INCLUDE    "scheme.ash"
  27.  
  28. DATASEG
  29. obj_cntr DW    1
  30.  
  31. CODESEG
  32. ;************************************************************************
  33. ;*                  Object Hash                *
  34. ;************************************************************************
  35. PROC C    objhash USES si di, @@reg:WORD
  36.     LOCAL    @@cntr:REG
  37.  
  38.     cmp    [obj_hlist.page], 0    ; anyone home ?
  39.     je    @@notfound
  40.  
  41.     mov    bx, [@@reg]
  42.     mov    ax, [(REG bx).disp]
  43.     mov    dx, [(REG bx).page]
  44.     mov    bl, [obj_hlist.page]
  45.     mov    bh, 0
  46.     ldpage    es, bx
  47.     mov    si, [obj_hlist.disp]
  48.     call    lookup             ; search the a-list
  49.     cmp    bl, 0
  50.     je    @@notfound
  51.  
  52.     mov    ax, [(LISTDEF es:di).cdr.disp]    ; load the hash counter
  53.     jmp    @@ret
  54.  
  55. @@notfound:                ; make a new entry 
  56.     mov    ax, [obj_cntr]         ; load obj hash counter 
  57.     push    ax
  58.     inc    [obj_cntr]
  59.     mov    [tmp_reg.page], SPECFIX*2 ; convert hash counter to a fixnum
  60.     mov    [tmp_reg.disp], ax
  61.     mov    ax, [@@reg]
  62.     lea    cx, [tmp_reg]
  63.     call    cons C, cx, ax, cx    ; tmp_reg = (object . hash-counter)
  64.     lea    bx, [nil_reg]
  65.     lea    cx, [tmp_reg]
  66.     call    cons C, cx, cx, bx    ; tmp_reg = ((obj . hash))
  67.     mov    bx, [tmp_reg.page]     ; load pointer to newest list cell
  68.     mov    ax, [tmp_reg.disp]
  69.     ldpage    es, bx
  70.     mov    si, ax             ; newly created list in [es:si]
  71.     xchg    [obj_hlist.page], bl     ; header <-> pointer to list cell
  72.     xchg    [obj_hlist.disp], ax
  73.     mov    [(LISTDEF es:si).cdr.page], bl ; (set-cdr! list-cell chain-header)
  74.     mov    [(LISTDEF es:si).cdr.disp], ax
  75.     pop    ax            ; restore the counter
  76. @@ret:
  77.     mov    bx, [@@reg]         ; load destination register's address
  78.     mov    [(REG bx).page], SPECFIX*2
  79.     mov    [(REG bx).disp], ax
  80.     ret
  81. ENDP    objhash
  82.  
  83. PROC C    objunhash USES si, @@reg:WORD
  84.     mov    si, [@@reg]
  85.     mov    bx, [(REG si).page]
  86.     cmp    bl, SPECFIX*2
  87.     je    @@maybe
  88. @@definitelynot:
  89.     xor    ax, ax            ; load nil
  90.     xor    dl, dl
  91.     jmp    @@wipeout
  92. @@maybe:
  93.     mov    ax, [(REG si).disp]
  94.     cmp    ax, [obj_cntr]        ; test against next available counter value
  95.     jae    @@definitelynot        ; hash index too large? if so, jump
  96.     lea    di, [obj_hlist]
  97.     push    ds
  98.     pop    es            ; [es:di] is the chain of objects
  99.     jmp    @@inloop
  100. @@next:
  101.     pop    es
  102.     lea    di, [(LISTDEF es:di).cdr] ; follow the chain (cdr linked)
  103. @@inloop:
  104.     mov    bl, [(POINTER es:di).page]
  105.     mov    di, [(POINTER es:di).disp]
  106.     cmp    bl, NIL_PAGE*2        ; end of chain?
  107.     je    @@definitelynot
  108.     ldpage    es, bx
  109.     push    es            ; we'll maybe need to back up
  110.     mov    bl, [(LISTDEF es:di).car.page]
  111.     mov    si, [(LISTDEF es:di).car.disp]
  112.     ldpage    es, bx            ; now [es:si] is a pair.
  113.     cmp    [(LISTDEF es:si).cdr.disp], ax    ; is it our number?
  114.     jne    @@next
  115.     pop    ax            ; cleanup the stack
  116.     mov    ax, [(POINTER es:si).disp]
  117.     mov    dl, [(POINTER es:si).page]
  118. @@wipeout:
  119.     mov    di, [@@reg]
  120.     mov    [(REG di).disp], ax
  121.     mov    [(REG di).bpage], dl
  122.     ret
  123. ENDP    objunhash
  124.  
  125. ;************************************************************************
  126. ;*           Object Hash Table Garbage Collection            *
  127. ;************************************************************************
  128. PROC C    gc_oht USES si di
  129.     LOCAL    $$pair:REG, $$current:REG, $$previous:REG
  130.  
  131.     lea    si, [obj_hlist]
  132.     push    ds
  133.     pop    es
  134.     call    colnext
  135.     ret
  136.  
  137. ;************************************************************************
  138. ;*      Local Support for Object Hash Table Garbage Collection    *
  139. ;************************************************************************
  140. PROC NOLANGUAGE colnext near
  141. DATASEG
  142. @@table    DW    @@list             ; [0] List cells
  143.     DW    @@mark             ; [1] Fixnums
  144.     DW    @@var             ; [2] Flonums
  145.     DW    @@var             ; [3] Bignums
  146.     DW    @@var             ; [4] Symbols
  147.     DW    @@var             ; [5] Strings
  148.     DW    @@var             ; [6] Arrays
  149.     DW    @@var             ; [7] Continuations
  150.     DW    @@var             ; [8] Closures
  151.     DW    @@mark             ; [9] Free page
  152.     DW    @@var             ; [10] Code block
  153.     DW    @@var             ; [11] Inline code
  154.     DW    @@var             ; [12] Port data objects
  155.     DW    @@mark             ; [13] Characters
  156.     DW    @@var             ; [14] Environments
  157. CODESEG
  158.     mov    [$$previous.page], 0
  159.     mov    [$$previous.disp], si
  160. @@loop:
  161.     xor    bx, bx
  162.     mov    bl, [(LISTDEF es:si).car.page]
  163.     or    bl, bl             ; does entry exist?
  164.     jnz    @@ok
  165.     ret
  166. @@ok:
  167.     mov    di, [(LISTDEF es:si).car.disp] ; compute and save pointer to current cell
  168.     ldpage    es, bx
  169.     mov    [$$current.page], bx
  170.     mov    [$$current.disp], di
  171.     mov    bl, [(LISTDEF es:di).car.page] ; compute and save pointer to object/hash-key pair
  172.     mov    si, [(LISTDEF es:di).car.disp]
  173.     test    bl, GC_BIT        ; is current cell marked as referenced?
  174.     jz    @@doitnow
  175.     jmp    @@skip
  176. @@doitnow:                ; if marked, GC during OBJECT-HASH
  177.     ldpage    es, bx
  178.     mov    [$$pair.page], bx
  179.     mov    [$$pair.disp], si    ; see what object pointer points to
  180.     mov    bl, [(LISTDEF es:si).car.page]
  181.     cmp    bl, DEDPAGES*2        ; is object a "special" one?
  182.     jb    @@mark             ; if a non-gc'ed page, must keep entry
  183.     mov    si, [(LISTDEF es:si).car.disp]
  184.     ldpage    es, bx
  185.     mov    di, [word ptype+bx]     ; load type code for object
  186.     jmp    [@@table+di]
  187. @@list:
  188.     test    [(LISTDEF es:si).gc], GC_BIT
  189.     jnz    @@mark
  190.     jmp    @@del
  191. @@var:
  192.     test    [(ANYDEF es:si).gc], GC_BIT
  193.     jnz    @@mark
  194. @@del:
  195.     ldpage    es, [$$current.page]
  196.     mov    si, [$$current.disp]
  197.     mov    ax, [(LISTDEF es:si).cdr.disp]
  198.     mov    bl, [(LISTDEF es:si).cdr.page]
  199.     cmp    [$$previous.page], 0
  200.     push    ds
  201.     pop    es
  202.     je    @@wasinDS
  203.     ldpage    es, [$$previous.page]
  204. @@wasinDS:
  205.     mov    si, [$$previous.disp]
  206.     mov    [(LISTDEF es:si).car.disp], ax
  207.     mov    [(LISTDEF es:si).car.page], bl
  208.     jmp    @@loop
  209. @@mark:
  210.     ldpage    es, [$$pair.page]
  211.     mov    si, [$$pair.disp]
  212.     or    [(LISTDEF es:si).gc], GC_BIT
  213. @@skip:
  214.     mov    bx, [$$current.page]
  215.     mov    si, [$$current.disp]
  216.     ldpage    es, bx
  217.     or    [(LISTDEF es:si).gc], GC_BIT
  218.     add    si, SIZE POINTER    ; this is the last valid one
  219.     mov    [$$previous.page], bx
  220.     mov    [$$previous.disp], si    
  221.     jmp    @@loop
  222. ENDP    colnext
  223.  
  224. ENDP    gc_oht
  225.  
  226.     END
  227.